home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 4 / DATAFILE_PDCD4.iso / utilities / utilsf / jfshared / Modules / FunMenus / Source`v1, < prev    next >
Encoding:
Text File  |  1995-08-26  |  10.5 KB  |  274 lines

  1. In   -
  2. Out  FunMenus
  3. Type Module
  4. Ver  1.00i
  5.  
  6. Define Workspace
  7.  Name    MenuItem
  8.  Default r2
  9.   `mflags    !      menu item flags
  10.   `submenu   !      sub-menu pointer
  11.   `iflags    !      icon flags
  12.   `string    $12    menu text
  13.  
  14.  Name    MenuBlock
  15.  Default r1
  16.   `title     $12    menu title
  17.   `tfore     %      title foreground and frame colour
  18.   `tback     %      title background colour
  19.   `wfore     %      workarea foreground colour
  20.   `wback     %      workarea background colour
  21.   `width     !      width of menu items
  22.   `height    !      height of menu items
  23.   `gap       !      gap between items
  24.   `data      ^MenuItem   items of data
  25.  
  26.  Name     Module
  27.  Default  r12
  28.   `colour    !      next colour offset
  29.   `menu      !      pointer to last menu structure
  30. End Workspace
  31.  
  32. End Workspace
  33. Define Module
  34.  Name      FunMenus
  35.  Author    Justin Fletcher
  36.  Workspace *`len_Module
  37.  WimpSWIs
  38.   SWI   Wimp_CreateMenu
  39.   Pre   swi_createmenu
  40.  
  41.   SWI   Wimp_CreateSubMenu
  42.   Pre   swi_createsubmenu
  43.  End WimpSWIs
  44.  PostFilter
  45.   Name   Fun menus
  46.   Task   -
  47.   Code   filter_post
  48.   Accept Message
  49.   Accept MessageRec
  50.   Accept MenuSelection
  51.  End PostFilter
  52. End Module
  53.  
  54. #REM OFF
  55. .filter_post
  56.    STMFD   (sp)!,{r1-r5,link}            ; Stack registers
  57.    CMP     r0,#17
  58.    CMPNE   r0,#18
  59.    BEQ     message
  60.    CMP     r0,#9
  61.    BEQ     menuselection
  62. .exit_filter
  63.    LDMFD   (sp)!,{r1-r5,pc}              ; Return from call
  64.  
  65. .menuselection
  66.    BL      findentry
  67.    CMN     r2,#1                         ; is this really a shaded option ?
  68.    STREQ   r2,[r1]                       ; if so, mark as such
  69.    BEQ     exit_filter                   ; and exit
  70.    LDRW    r2,`iflags                    ; otherwise, get icon flags
  71.    AND     r2,r2,#15<<24                 ; leave just the foreground
  72.    CMP     r2,#0                         ; if 0 then is shaded
  73.    MVNEQ   r2,#NOT -1                    ; so get -1 ...
  74.    STREQ   r2,[r1]                       ; ... and store in selection block
  75.    BEQ     exit_filter                   ; and exit
  76.  
  77. .message
  78.    LDR     r2,[r1,#16]                   ; get message code
  79.    SUB     r2,r2,#&40000                 ; is it equal to &400C0
  80.    CMP     r2,#&C0                       ; ?
  81.    BNE     exit_filter
  82.    STMFD   (sp)!,{r0}
  83.    ADD     r1,r1,#32                     ; offset to selection list
  84.    LDR     r0,[r1]
  85.    REM     "%c04Submenu opening, option %r0"
  86.    BL      findentry                     ; find the entry and return in r2
  87.    REM     "Is option %r2"
  88.    LDRW    r3,`iflags                    ; get icon flags
  89.    AND     r3,r3,#15<<24                 ; get foreground colour
  90.    CMP     r3,#0                         ; is it white ?
  91.    BNE     $notshaded                    ; if not then bypass
  92.    REM     "Is shaded"
  93.    LDRW    r3,`mflags                    ; get menu flags
  94.    TST     r3,#1<<4                      ; can it be opened when greyed ?
  95.    BNE     $canopen                      ; if it can then it can open
  96. $taskseesnothing
  97.    REM     "Task sees nothing"
  98.    ADD     sp,sp,#4                      ; increment stack to remove reason
  99.    MOV     r0,#0                         ; can't open, so no sub-menu
  100.    B       exit_filter                   ; so exit the filter
  101.  
  102. $canopen
  103.    REM     "Can be opened if grey"
  104.    SUB     r1,r1,#12                     ; move pointer back to sub-menu ptr
  105. ;    BL      checkwindow                   ; is it a window ?
  106. ;    BEQ     $taskseesnothing              ; if so, exit
  107.    LDMIA   r1,{r1,r2,r3}                 ; read pointer, and locations
  108.    REM     "Opening menu at %&1"
  109.    SWI     "Wimp_CreateSubMenu"          ; and create the sub-menu
  110.    B       $taskseesnothing
  111. $notshaded
  112.    LDMFD   (sp)!,{r0}                    ; not shaded so restore reason
  113.    B       exit_filter                   ; and pass back to task
  114.  
  115. .swi_createmenu
  116.    STMFD   (sp)!,{r0-r5,link}            ; Stack registers
  117.    STRW    r1,`menu
  118.    BL      scanstructure
  119.    LDMFD   (sp)!,{r0-r5,pc}              ; Return from call
  120.  
  121. .swi_createsubmenu
  122.    STMFD   (sp)!,{r0-r5,link}            ; Stack registers
  123.    BL      scanstructure
  124.    LDMFD   (sp)!,{r0-r5,pc}              ; Return from call
  125.  
  126. ; checkwindow - tests to see if menu pointer is invalid (EQ if so)
  127. ; > r1 = menu pointer
  128. ; < EQ if window
  129. .checkwindow
  130.    STMFD   (sp)!,{r0-r5,link}            ; Stack registers
  131.    CMN     r1,#1                         ; -1 if close menu
  132.    CMPNE   r1,#0                         ; or if 0 don't process
  133.    BEQ     $exit                         ; y = exit
  134.    MOV     r0,r1                         ; r0=menu address
  135.    BIC     r0,r0,#3                      ; word align
  136.    ADD     r1,r0,#28+24                  ; end of block
  137.    SWI     "XOS_ValidateAddress"         ; check exists
  138.    BCS     $exitwitheq                   ; if not valid exit
  139.    BVS     $exitwitheq                   ; if error exit
  140.    SUB     r1,r1,#28+24                  ; restore block address
  141.    LDR     r0,[r1]                       ; get first word
  142.    LDR     r2,$`windtext                 ; get word Wind
  143.    CMP     r0,r2                         ; if same then a window block
  144.                                          ; EQ status is returned
  145. $exit
  146.    LDMFD   (sp)!,{r0-r5,pc}              ; Return from call
  147. $exitwitheq
  148.    CMP     r0,r0                         ; sets EQ status
  149.    LDMFD   (sp)!,{r0-r5,pc}              ; Return from call
  150.  
  151. $`windtext
  152.    EQUS    "Wind"
  153.  
  154. .scanstructure
  155.    STMFD   (sp)!,{r0-r5,link}            ; Stack registers
  156.    BL      checkwindow
  157.    BEQ     $exit
  158.    ADRW    r2,`data                      ; get pointer to menu items
  159.    LDRW    r0,`colour                    ; get colour counter
  160.    ADR     r4,$`colours                  ; get address into colour block
  161. $tryagain
  162.    LDR     r3,[r4,r0,LSL #2]             ; get word from block
  163.    CMN     r3,#1                         ; is it -1 ?
  164.    MOVEQ   r0,#0                         ; if so restart...
  165.    BEQ     $tryagain                     ; ...and get colour again
  166.    ADD     r0,r0,#1                      ; increment counter
  167.    STRW    r0,`colour                    ; and store back in block
  168.    STRBW   r3,`wback                     ; store colour as background colour
  169. $loop
  170.    LDRW    r0,`iflags                    ; get flags
  171.    LDRW    r4,`mflags                    ; get menu flags
  172.    TST     r0,#1<<6                      ; is it anti-aliased ?
  173.    BNE     $colouruntouched              ; don't touch colour if anti-aliased
  174.    BIC     r0,r0,#1<<5                   ; clear filled flag
  175.    BIC     r0,r0,#15<<28                 ; clear background colour
  176.    ORR     r0,r0,r3,LSL #28              ; and replace with new colour
  177.    TST     r0,#1<<22                     ; unselectable ?
  178.    BEQ     $isselectable
  179.    BIC     r0,r0,#15<<24                 ; clear foreground colour
  180.    BIC     r0,r0,#1<<22                  ; and clear unselectable bit
  181. ;    LDRW    r1,`submenu                   ; get submenu pointer
  182. ;    BL      checkwindow                   ; is it valid ?
  183.    TST     r4,#1<<4                      ; is there sub-menu when grey ?
  184.    ORRNE   r4,r4,#1<<3                   ; if so, add message when open
  185.    B       $colouruntouched
  186. $isselectable
  187.    TST     r4,#1<<4                      ; is selectable. is submenu if grey?
  188.    BICNE   r4,r4,#1<<3                   ; if so, then unset make message
  189.    BIC     r0,r0,#15<<24                 ; clear foreground colour
  190.    ORR     r0,r0,#7<<24                  ; and set to black instead
  191. $colouruntouched
  192.    STRW    r0,`iflags                    ; store back in buffer
  193.    STRW    r4,`mflags
  194.    TST     r4,#1<<3                      ; is msg when open sub set ?
  195.    LDRWEQ  r1,`submenu                   ; n = get submenu pointer
  196.    BLEQ    scanstructure                 ; n = scan the submenu for menus
  197.    TST     r4,#1<<7                      ; is this last item ?
  198.    ADDEQ   r2,r2,#`len_MenuItem          ; increment block pointer
  199.    BEQ     $loop
  200. $exit
  201.    LDMFD   (sp)!,{r0-r5,pc}^             ; Return from call
  202.  
  203. $`colours
  204.    EQUD    9
  205.    EQUD    10
  206.    EQUD    11
  207.    EQUD    12
  208.    EQUD    14
  209.    EQUD    15
  210.    EQUD    -1
  211.  
  212. ; > r1 = selection block
  213. ; < r2 = pointer to menu item contained (or -1)
  214. .findentry
  215.    STMFD   (sp)!,{r0-r1,r3-r5,link}     ; Stack registers
  216.    LDRW    r0,`menu                     ; get menu pointer
  217. #MAPWS MenuBlock,r0
  218. $nextlevel
  219.    MOV     r2,r1                        ; store selection block in r2
  220.    MOV     r1,r0                        ; r1=menu pointer
  221.    BL      checkwindow                  ; is it valid ?
  222.    BEQ     $exitnodata                  ; if not, exit with no entry data
  223.    MOV     r1,r2                        ; restore selection block
  224.    LDR     r3,[r1],#4                   ; get first offset and increment
  225.    REM     "Finding item, option = %r3"
  226.    CMN     r3,#1                        ; is it -1 ?
  227.    BEQ     $exitnodata
  228.    ADRW    r2,`data                     ; r2=address of data
  229. $findloop
  230.    SUBS    r3,r3,#1                     ; decrement menu selection
  231.    BMI     $foundentry                  ; if -ve, then found
  232. ;    REM     "Items to check = %r3"
  233.    LDRW    r0,`submenu
  234. ;    REM     "Sub menu = %&0"
  235.    LDRW    r0,`mflags                   ; get menu flags
  236. ;    REM     "Menu flags = %&0"
  237.    TST     r0,#1<<7                     ; last item ?
  238.    BNE     $exitnodata                  ; if so then no data
  239.    ADD     r2,r2,#`len_MenuItem         ; increment block
  240.    B       $findloop
  241.  
  242. $foundentry
  243.    LDRW    r0,`iflags                   ; get icon flags
  244.    AND     r0,r0,#15<<24                ; get foreground colour
  245.    CMP     r0,#0                        ; is it white (ie shaded)
  246.    BNE     $notshaded                   ; if not, then jump
  247.    REM     "Is shaded"
  248. ;    LDR     r3,[r1]                      ; get next selection entry
  249. ;    CMN     r3,#1                        ; is this last one ?
  250. ;    BEQ     $exit                        ; if so then exit with data
  251. ;    B       $exitnodata                  ; if not, exit with no block
  252.  
  253. $notshaded
  254.    REM     "Not shaded"
  255.    LDR     r3,[r1]                      ; get next selection entry
  256.    CMN     r3,#1                        ; is this last one ?
  257.    BEQ     $exit                        ; if so exit with data
  258.    LDRW    r0,`submenu                  ; otherwise r0=sub menu pointer
  259.    CMN     r0,#1                        ; is it -1 ?
  260.    BEQ     $exitnodata                  ; if so, there are no more entries!
  261.    B       $nextlevel                   ; otherwise go through it all again
  262.  
  263. $exitnodata
  264.    REM     "Returning nothing"
  265.    MVN     r2,#NOT -1                   ; no data, so return null pointer
  266. $exit
  267.    LDMFD   (sp)!,{r0-r1,r3-r5,pc}       ; Return from call
  268.  
  269. #Post
  270. #Run <CODE>
  271. REM *Run Resources:$.Apps.!Draw
  272. *Filer_OpenDir Resources:$.Apps
  273. *Key1Rmreinit filer|Mfx138,0,13|Mwimptask desktop|M
  274.